perm filename PXMOVF.OLD[MSS,LCS] blob
sn#178141 filedate 1975-09-24 generic text, type T, neo UTF8
00100 TITLE PTMOVF; ********* JUN 8,74 *********
00200 INTERNAL LOOK,LOOKD,LOOKF
00300 ENTRY GETPTS,MOVIT,EXTEN
00400 DEFINE ERROR (MSG)
00500 < JSA 16,.ERROR
00600 JUMP [ASCIZ/MSG/
00700 ]
00800 >
00900
01000 .ERROR: 0
01100 OUTSTR [ASCIZ/?
01200 /] ;MAKE SURE HE CAN SEE HIS ERROR
01300 OUTSTR @(16) ;OUTPUT ERROR MESSAGE
01400 CALLI 1,12 ;LET USER CONTI2UE
01500 JRA 16,1(16)
01600
01700 CH←13
01800
01900 REGS: BLOCK 20
02000
02100 ;LOOK(<FILE>) FOR NO EXT., LOOKD() FOR .DAT, LOOKF() FOR .DMD
02200
02300 LOOKF: 0
02400 MOVSI 0,'DMD'
02500 JRST LOOK1
02600 LOOKD: 0
02700 MOVSI 0,'DAT'
02800 JRST LOOK1
02900 LOOK: 0
03000 MOVEI 0,0
03100 LOOK1: MOVEM 0,DIR+1
03200 MOVE 0,@(16)
03300 MOVEM 0,FILNAM
03400 JSA 16, INTFIQ
03500 SETZM DIR+2
03600 SETZM DIR+3
03700 LOOKUP CH,DIR
03800 TDZA 0,0
03900 MOVNI 0,1
04000 JRA 16,1(16)
04100
04200 INTFIQ: 0 ;INITS DSK FOR INPUT
04300 MOVEI REGS
04400 BLT REGS+3
04500 INIT CH,17
04600 SIXBIT/DSK/
04700 0
04800 HALT .-3
04900 ; ERROR <CAN'T INIT DSK!>
05000
05100 INTF4: MOVE 0,FILNAM#
05200 MOVEM 0,FN#
05300 MOVE 1,[POINT 7,FN]
05400 INTF3: MOVE 2,[POINT 6,DIR]
05500 SETZM DIR
05600 MOVEI 3,5
05700 INTF1: ILDB 0,1
05800 CAIN 0," "
05900 JRST INTF2
06000 SUBI 0,40
06100 IDPB 0,2
06200 SOJG 3,INTF1
06300 INTF2: HRLZI REGS
06400 BLT 3
06500 JRA 16,0(16)
06600
06700 DIR: BLOCK 4
06800 EXTERNAL .COMM.,XRN,KJY,PTR,POSI,AMOD,KNR,NNP
06900
07000 K←15↔J←14↔ M←2↔ R2←5↔ X←6↔ L←4↔ R←7↔ A←11↔RY←3↔RZ←13↔JJ2←12
07100 DEFINE FIXX(N)
07200 < JUMPGE N,.+5
07300 MOVNS N
07400 FIX N,233000
07500 MOVNS N
07600 CAIA
07700 FIX N,233000 > ; TO FIX IT LIKE 'IFIX' DOES.
07800
07900 ; SUBROUTINE GETPTS
08000 ; COMMON/KNR/N(500) /NNP/NP(500)
08100 ; COMMON/XRN/RN(4000) /KJY/ K,J
08200 ; COMMON R2,JA,CENTR,J2,RJQ(18),RX6,JR,L,RDIS
08300 ; 1/PTR/PWDS(250),ITEM,LL,I,IX
08400 ; EQUIVALENCE (R4,RJQ(2)),(R5,RJQ(3)),(R11,RJQ(9))
08500 ; 1,(R6,RJQ(4))
08600
08700 GETPTS: 0 ;CALL GETPTS(N,RN,PWDS)
08800 SETZ J, ; J=0
08900 SETZ K, ; K=0
09000 MOVE JJ2,POSI+=8
09100 MOVE R2,.COMM.
09200 SETZ X,
09300 ;; MOVE X,@(16)
09400 ;; SOS X
09500 MOVEI M,@2(16); DO 1 M=1,ITEM
09600 ADDI M,(X)
09700 G1: AOJ X,
09800 MOVE L,(M)
09900 FIXX(L)
10000 MOVEI R,@1(16) ;L=PWDS(M)
10100 ADDI R,(L) ;IF(RTLINE(L))GO TO 1
10200 MOVE 1,1(R) ;RN(L+2)
10300 CAML R2,[=5.0]
10400 JRST GZ
10500 CAME R2,1
10600 JRST GX
10700 GZ: MOVE A,.COMM.+7 ;RY=RN(L+1)
10800 JUMPLE A,G9 ;F(R6.LE.0)GO TO 9
10900 CAME A,(R) ;IF(R6.NE.RY)GO TO 1
11000 JRST GX
11100 ; CHECK CODE NUM
11200 G9: MOVE A,2(R)
11300 CAMLE A,.COMM.+6 ;R5
11400 JRST G2 ;9 IF(OUTLIM(R4,R5,RN(L+3)))GO TO 2
11500 CAMGE A,.COMM.+5 ;R4
11600 JRST G2
11700
11800 SKIPG JJ2
11900 MOVE JJ2,X
11910 MOVE .COMM.+=8 ;RN(L+2)=R7
11920 MOVEM 1(R)
12000 AOJ J,
12100 ; IN LIMITS?
12200 ; MOVEI A,XRN+=2498 ;J=J+1
12300 MOVEI A,KNR-1
12400 ADDI A,(J)
12500 MOVEI 0,(L)
12600 AOJ K, ;K=K+1
12700 ; MOVEI 1,XRN+=2998
12800 MOVEI 1,NNP-1
12900 ADDI 1,(K) ;NP(K)=L
13000 MOVEM 0,(1)
13100 ADDI 0,3 ;N(J)=L+3
13200 MOVEM 0,(A)
13300 ; NP IS FOR USE IN JUSTIFY ROUTINE
13400 G2: MOVE RY,(R) ;2 IF(RY.LT.4)GO TO 1
13500 CAMGE RY,[=4.0]
13600 JRST GX
13610 CAMN RY,[=44.0] ;CODE 4 IS SOMETIMES =44
13620 JRST G5 ;FOUND A LINE
13700 CAMLE RY,[=7.0]
13800 JRST GX ;IF(RY.GT.7)GO TO 1
13900 ; TWO-ENDED ITEM?
14000 MOVE RZ,-1(R) ;RZ=RN(L)
14100 ; WD CNT
14200 CAMN RY,[=4.0] ;GO TO(4,5,6,7),IFIX(RY)-3
14300 JRST G4
14400 CAMN RY,[=5.0]
14500 JRST G5
14600 CAMN RY,[=6.0]
14700 JRST G6
14800 CAMG RZ,[=4.0] ;4 IF(RZ.GT.2)GO TO 5
14900 JRST G5 ; THERE IS A TRILL WIGGLE
15000 JRST GX ;GO TO 1 -- NO WIGGLE (P7≠0)
15100 G4: CAMG RZ,[=2.0] ;7 IF(RZ.GT.3)GO TO 5
15200 JRST GX
15300 JRST G5 ;GO TO 1
15400 G6: CAMGE RZ,[=8.0] ;6 IF(RZ.LT.8)GO TO 8
15500 JRST G8
15600 ;; MOVEI 1,XRN ;IF(RN(L+10).LT.30)GO TO 8
15700 ;; ADDI 1,(L)
15800 ;; MOVE 1,11(1)
15900 MOVE 1,=9(R)
16000 CAMGE 1,[=30.0]
16100 JRST G8
16200 MOVE A,7(R) ; IF(OUTLIM(R4,R5,RN(L+8)))GO TO 8
16300 CAMLE A,.COMM.+6
16400 JRST G8
16500 CAMGE A,.COMM.+5
16600 JRST G8
16700 SKIPG JJ2
16800 MOVE JJ2,X
16900 AOJ J,
17000 ; IN LIMITS?
17100 ; MOVEI A,XRN+=2498 ;J=J+1
17200 MOVEI A,KNR-1
17300 ADDI A,(J)
17400 MOVEI 0,(L) ;J=J+1
17500 ADDI 0,=8 ;N(J)=L+8
17600 MOVEM 0,(A)
17700 G8: CAMGE RZ,[=7.0] ;8 IF(RZ.LT.7)GO TO 5
17800 JRST G5
17900 MOVE A,6(R) ;IF(RN(L+7))GO TO G8B
18000 JUMPL A,G8B ; P7 IS NEG FOR TREMOLO
18100 MOVE A,7(R) ;IF(RN(L+8).NE.0)GO TO G8B
18200 JUMPN A,G8B
18300 CAMGE RZ,[=8.0]
18400 JRST G5 ;IF(RZ.LT.8)GO TO G5
18500 MOVE A,=9(R) ;IF(RN(L+10).EQ.0)GO TO G5
18600 JUMPE A,G5 ;PASSES NUMBER OVER BEAM.
18700 G8B: MOVE A,8(R)
18800 CAMLE A,.COMM.+6
18900 JRST G5
19000 CAMGE A,.COMM.+5 ;R4
19100 JRST G5
19200
19300 SKIPG JJ2
19400 MOVE JJ2,X
19500 AOJ J, ;J=J+1
19600 ; IN LIMITS?
19700 ; MOVEI A,XRN+=2498 ;J=J+1
19800 MOVEI A,KNR-1
19900 ADDI A,(J)
20000 MOVEI 0,(L)
20100 ADDI 0,=9 ;IF(OUTLIM(R4,R5,RN(L+9)))GO TO 5
20200 MOVEM 0,(A) ;N(J)=L+9
20300 G5: MOVE A,5(R)
20400 CAMLE A,.COMM.+6
20500 JRST GX
20600 CAMGE A,.COMM.+5 ;R4
20700 JRST GX
20800
20900 SKIPG JJ2
21000 MOVE JJ2,X
21100 AOJ J,
21200 ; IN LIMITS?
21300 ;| MOVEI A,XRN+=2498 ;J=J+1
21400 MOVEI A,KNR-1
21500 ADDI A,(J)
21600 MOVEI 0,(L) ;5 IF(OUTLIM(R4,R5,RN(L+6)))GO TO 1
21700 ADDI 0,6 ;N(J)=L+6
21800 MOVEM 0,(A)
21900 GX: CAMGE X,PTR+=250 ;1 CONTINUE
22000 AOJA M,G1
22100 MOVEM JJ2,POSI+=8
22200 MOVEM J,KJY+1
22300 MOVEM K,KJY
22400 JRA 16,3(16)
22500
22600 ; SUBROUTINE MOVIT(RN)
22700 ; COMMON /KNR/ N(500)
22800 ; COMMON /KJY/ DONT,J
22900 ; COMMON R2,JA,CENTR,J2,RJQ(18),RX6,JR,L,RDIS
23000 ; EQUIVALENCE (R4,RJQ(2)),(R5,RJQ(3)),(R9,RJQ(7))
23100 ; 1,(R6,RJQ(4)),(N,RN(2500)),(R8,RJQ(6))
23200 MOVIT: 0 ;RDIS=(R9-R8)/(R5-R4)
23300 MOVE R,.COMM.+=10
23400 FSBR R,.COMM.+=9
23500 MOVE RY,.COMM.+6
23600 FSBR RY,.COMM.+5
23700 FDVR R,RY
23800 ; MOVEI L,XRN+=2499 ; DO 1 K=1,J
23900 MOVEI L,KNR
24000 SETZ K,
24100 MOVE 0,.COMM.+=10 ; SET UP R9
24200 M1: MOVE X,L ; L=N(K)
24300 MOVE A,(X)
24400 MOVEI R2,@(16) ;RA=RN(L)
24500 ADDI R2,(A)
24600 MOVEI RZ,(R2)
24700 MOVE R2,-1(R2)
24800 CAMGE R2,.COMM.+5 ;IF(OUTLIM(R4,R5,RA))GO TO 1
24900 JRST MX
25000 CAMLE R2,.COMM.+6
25100 JRST MX
25200 JUMPE 0,M2 ;IF(R9.NE.0)RA=(RA-R4)*RDIS
25300 FSBR R2,.COMM.+5
25400 FMPR R2,R
25500 M2: FADR R2,.COMM.+=9 ; RN(L)=R8+RA
25600 MOVEM R2,-1(RZ)
25700 MX: AOJ K, ;1 CONTINUE
25800 CAMGE K,KJY+1
25900 AOJA L,M1
26000 JRA 16,1(16)
26100
26200 EXTEN: 0 ;FUNCTION EXTEN(X)
26300 HRRM 16,.+2
26400 JSA 16,AMOD ;EXTEN=AMOD(X,1.)*10.
26500 JUMP @0
26600 JUMP [=1.0]
26700 FMPR [=10.0]
26800 JRA 16,1(16)
26900
29400 END